home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / M / MathFacts(Obj.logo) < prev    next >
Encoding:
Text File  |  1987-05-25  |  13.0 KB  |  490 lines  |  [TEXT/MACA]
  1. ;*
  2. ;* 
  3. ;*  Program Name:  Math Facts  V1.0
  4. ;*  Date Written:  May 11, 1987 
  5. ;*  Author:        Christopher J. Flynn
  6. ;*                 2601 Claxton Drive 
  7. ;*                 Herndon, VA 22071 
  8. ;*  Description:        
  9. ;*      Math Facts is a simple drill and practise game.  It presents 
  10. ;*      the user with randomly generated arithmetic problems.  The  
  11. ;*      user responds by clicking on appropriate buttons which are
  12. ;*      displayed on the screen.  The program does not keep 'score'
  13. ;*      and problems can be skipped entirely without penalty. 
  14. ;*                         
  15. ;*      To run, load the file into an edit window.  Select all with
  16. ;*      Command-A, run with Command-R.  Be patient, compilation takes
  17. ;*      a little while!
  18. ;*
  19. ;*      NOTE: MacInTalk MUST be in your system folder.  This program
  20. ;*      uses speech.  
  21. ;*
  22. ;*      NOTE: for best results, install Monaco 24 in your system file.           
  23. ;*                        
  24. ;*      NOTE: this program is written in an object-oriented style.
  25. ;*      You can establish multiple instances of the game by typing
  26. ;*      the following lines in the Listener window: 
  27. ;*                                                   
  28. ;*         make "NewGameWindow oneof :GameWindow
  29. ;*         MakeSomeButtons :NewGameWindow
  30. ;*
  31. ;*      Use whatever name you want for the new window.
  32. ;*
  33. ;*
  34. ;*      NOTE: Version 1.5 or above of Object Logo is required.     
  35. ;*      Conact: Coral Software
  36. ;*              P.O. Box 307
  37. ;*              Cambridge, MA 02142
  38. ;*
  39. ;*      NOTE: This program may be freely distributed.
  40. ;*
  41. ;*
  42.  
  43.  
  44.  
  45.  
  46. ;
  47. ;  W I N D O W    O B J E C T    D E F I N I T I O N
  48. ;
  49.  
  50. make "GameWindow kindof TurtleWindow
  51.  
  52. ask :GameWindow [to exist]
  53.   Usual.Exist
  54.   HideTurtle
  55.   SetWSize [505 297]
  56.   SetWTitle "|Math Facts|
  57.   SetWFont "Monaco                          ;Whatever you wish
  58.   SetWFontSize 24                           ;Put exact size in system
  59.   SetWFontStyle [Bold] 
  60.   SetPenMode "Reverse
  61.   SetTextMode "Reverse
  62.   HaveMake "KeyPadRect [78 170 407 269]     ;Keypad for the game
  63.   HaveMake "ProblemRect [30 40 180 80]      ;Problems are displayed here
  64.   HaveMake "AnswerRect [300 40 450 80]      ;User's answers
  65.   HaveMake "MessageRect [78 100 407 160]    ;Messages
  66.   HaveMake "Gray [170 85 170 85 170 85 170 85]
  67.   HaveMake "LtGray [136 34 136 34 136 34 136 34]
  68.   HaveMake "Black [255 255 255 255 255 255 255 255]
  69.   DrawRectangle :KeyPadRect :Gray
  70.   DrawRectangle :ProblemRect :LtGray
  71.   DrawRectangle :AnswerRect :LtGray
  72.   DisplayAt 40 30 "|What Is?|
  73.   DisplayAt 283 30 "|Your Answer|
  74.   HaveMake "ButtonList []                   ;List of all button objects
  75.   HaveMake "YourAnswer "                    ;Answer entered by human
  76.   HaveMake "MyProblem "                     ;Generated math problem
  77.   HaveMake "MyAnswer "                      ;Answer to the problem
  78.   HaveMake "WhatKind "Mixed                 ;Type of problem
  79.   HaveMake "MaxAugend 50
  80.   HaveMake "MaxAddend 50
  81.   HaveMake "MaxMinuend 50
  82.   HaveMake "MaxSubtrahend 50
  83.   HaveMake "MaxMultiplicand 12
  84.   HaveMake "MaxMultiplier 12
  85.   HaveMake "MaxDividend 100
  86.   HaveMake "maxDivisor 12
  87.   DoNext                                    ;Make the first problem
  88. end
  89.  
  90.  
  91. ;
  92. ;  Procedure for drawing a bounded round rectangle and optionally
  93. ;  filling it with a pattern
  94. ;
  95.  
  96. ask :GameWindow [to DrawRectangle :Rectangle :Pattern]
  97.   LocalMake "HoldState GetPenState
  98.   SetPenSize 2 2
  99.   EraseRoundRect (InsetRect :Rectangle 2 2) 16 16
  100.   SetPenPat :Black
  101.   SetPenMode "Paint
  102.   FrameRoundRect :Rectangle 16 16
  103.   if not EmptyP :Pattern
  104. _   [SetPenPat :pattern
  105. _    PaintRoundRect (InsetRect :Rectangle 2 2) 16 16]
  106.   SetPenState :HoldState
  107. end
  108.  
  109.  
  110. ;
  111. ;  Display a string at the specified point.
  112. ;
  113. ask :GameWindow [to DisplayAt :X :Y :theText]
  114.   MoveTo :X :Y
  115.   type :theText
  116. end
  117.  
  118.  
  119. ;
  120. ; Intercept and process mouse clicks
  121. ;
  122.  
  123. ask :GameWindow [to WClick :X :Y :Mods]
  124.   LocalMake "PressedWhat FindTheButton :ButtonList :X :Y
  125.   if not EmptyP :PressedWhat
  126. _   [DoActionButton :PressedWhat]
  127.   Usual.WClick :X :Y :Mods
  128. end
  129.  
  130.  
  131. ;
  132. ;  Determine if the mouse was clicked in a button.  If so,
  133. ;  ask the button to process the click.  Output the button
  134. ;  object that was clicked.  If not, do nothing with the
  135. ;  and output "false.
  136. ;
  137. ;  Note: mouse button can be released outside of the
  138. ;  button.  This is treated as a non-click.
  139. ;
  140.  
  141. ask :GameWindow [to FindTheButton :ButtonList :X :Y]
  142.   if Emptyp :ButtonList [output []]
  143.   LocalMake "Me first :ButtonList
  144.   LocalMake "MyRect ask :Me [:ButtonRect]
  145.   if PtInRectP list :X :Y :MyRect
  146. _   [ask :Me [ClickButton]
  147. _    ifelse PtInRectp list mousex mousey :MyRect
  148. _      [output  ask :Me [:ButtonLabel]]
  149. _      [output []]]
  150.   FindTheButton butfirst :ButtonList :X :Y
  151. end
  152.  
  153. ;
  154. ;  G A M E - R E L A T E D    P R O C E D U R E S
  155. ;
  156. ;  These procedures are defined in the window object.  The procedures
  157. ;  faciltate interaction with the user by obtaining and acting on
  158. ;  "clicks" from the button objects.
  159. ;
  160.  
  161.  
  162. ;
  163. ;  Determine what to do when a button is "clicked".
  164. ;
  165.  
  166. ask :GameWindow [to DoActionButton :WhichButton]
  167.   ifelse Equalp :WhichButton "|Next|
  168. _   [DoNext]
  169. _   [ifelse EqualP :WhichButton "|O.K.!|
  170. _     [DoOK]
  171. _     [ifelse EqualP :WhichButton "|Help|
  172. _       [DoHelp]
  173. _       [ifelse EqualP :WhichButton "|Oops!|
  174. _         [DoOops]
  175. _         [DoDigit :WhichButton]]]]
  176. end
  177.  
  178.  
  179. ;
  180. ;  Process Next - Make a new math problem.  The type of operation
  181. ;  is specified by :WhatKind.  Display the problem and save the answer.
  182. ;
  183.  
  184. ask :GameWindow [to DoNext]
  185.   ask oneof speaker [speak "Next]
  186.   DrawRectangle :ProblemRect :LtGray
  187.   DrawRectangle :AnswerRect :LtGray
  188.   EraseRect :MessageRect
  189.   HaveMake "MyProblem MakeProblem :WhatKind
  190.   HaveMake "MyAnswer Run :MyProblem
  191.   DisplayTheProblem :MyProblem
  192.   HaveMake "YourAnswer " 
  193. end
  194.  
  195. ask :GameWindow [to DisplayTheProblem :Problem]
  196.   LocalMake "X item 1 :ProblemRect
  197.   LocalMake "Y item 2 :ProblemRect
  198.   Local [Operator OpWord]
  199.   EraseRoundRect (InsetRect :ProblemRect 2 2) 16 16
  200.   MoveTo :X :Y
  201.   Move 15 WFontSize + 4
  202.   Type :Problem
  203.   ask oneof speaker [speak "|What is|]
  204.   ask oneof speaker [speak item 1 :Problem]
  205.   make "Operator item 2 :Problem
  206.   if Equalp :Operator "+ [make "OpWord "Plus]
  207.   if Equalp :Operator "- [make "OpWord "Mighnus]
  208.   if Equalp :Operator "* [make "OpWord "Times]
  209.   if Equalp :Operator "/ [make "OpWord "|Divided By|]
  210.   ask oneof speaker [speak :OpWord]
  211.   ask oneof speaker [speak item 3 :Problem]
  212. end
  213.  
  214.  
  215. ;
  216. ;  Process OK - Check your answer agaisnt my answer
  217. ;
  218.  
  219. ask :GameWindow [to DoOK]
  220.   ask oneof speaker [speak "|O. K.|]
  221.   ifelse EqualP :MyAnswer :YourAnswer
  222. _   [DisplayCorrect
  223. _    DoNext]
  224. _   [DisplayIncorrect
  225. _    DrawRectangle :AnswerRect :LtGray
  226. _    HaveMake "YourAnswer " ]
  227. end
  228.  
  229. ask :GameWindow [to DisplayCorrect]
  230.   LocalMake "Temp Pick
  231. _  [|Very Good!| |Excellent!|  |That's Right!| |Super!|
  232. _   |Good Job!| |Correct!| |Excellent!| |You Got It!|]
  233.   ask oneof speaker [speak :Temp]
  234.   DisplayMessage :Temp
  235.   Wait 2
  236. end
  237.  
  238. ask :GameWindow [to DisplayIncorrect]
  239.   LocalMake "Temp Pick
  240. _  [|Sorry!| |Try Again!| |I Don't Think So!|
  241. _   |No.| |Look At It Again!| |Are You Kidding!|]
  242.   ask oneof speaker [speak :Temp]
  243.   DisplayMessage :Temp
  244.   Wait 2
  245.   EraseRect :MessageRect
  246. end
  247.  
  248.  
  249. ;
  250. ;  Process Help - Display the answer, pause, make another problem
  251. ;
  252.  
  253. ask :GameWindow [to DoHelp]
  254.   LocalMake "Ans :MyAnswer
  255.   ask oneof speaker [speak "Help]
  256.   DisplayMessage (se "|The answer is| :MyAnswer)
  257.   ask oneof speaker [speak (word "|The answer is| :Ans)]
  258.   wait 5
  259.   HaveMake "YourAnswer "
  260.   DoNext
  261. end
  262.  
  263.  
  264. ask :GameWindow [to DisplayMessage :What]
  265.   LocalMake "X item 1 :MessageRect
  266.   LocalMake "Y item 2 :MessageRect
  267.   EraseRect :MessageRect
  268.   MoveTo :X :Y
  269.   Move 1 WFontSize + 4
  270.   Type :What
  271. end
  272.  
  273.  
  274. ;
  275. ;  Process Oops! - Erase answer entered so far.
  276. ;
  277.  
  278. ask :GameWindow [to DoOops]
  279.   ask oneof speaker [speak "Oops]
  280.   HaveMake "YourAnswer "
  281.   DrawRectangle :AnswerRect :LtGray
  282. end
  283.  
  284.  
  285. ;
  286. ;  Collect digit "clicks" into an answer
  287. ;
  288.  
  289. ask :GameWindow [to DoDigit :WhichButton]
  290.   ask oneof speaker [speak :WhichButton]
  291.   HaveMake "YourAnswer word :YourAnswer :WhichButton
  292.   if greaterp (count :YourAnswer)  5
  293. _   [HaveMake "YourAnswer butfirst :YourAnswer]
  294.   DisplayYourAnswer :YourAnswer
  295. end
  296.  
  297.  
  298. ;
  299. ;  Display human's answer
  300. ;
  301.  
  302. ask :GameWindow [to DisplayYourAnswer :Answer]
  303.   LocalMake "X item 1 :AnswerRect
  304.   LocalMake "Y item 2 :AnswerRect
  305.   EraseRoundRect (InsetRect :AnswerRect 2 2) 16 16
  306.   MoveTo :X :Y
  307.   Move 34 WFontSize + 4
  308.   Type :Answer
  309. end
  310.  
  311. ;
  312. ;  P R O B L E M    G E N E R A T I O N    P R O C E D U R E S
  313. ;
  314.  
  315. ask :GameWindow [to Pick :theList]
  316.   op item 1 + random count :theList :theList
  317. end
  318.  
  319. ;
  320. ;  Generate a new problem based on the operator
  321. ;
  322.  
  323. ask :GameWindow [to MakeProblem :WhatProblem]
  324.   if EqualP :WhatProblem "+ [op MakeAddition]
  325.   if EqualP :WhatProblem "- [op MakeSubtraction]
  326.   if EqualP :WhatProblem "* [op MakeMultiplication]
  327.   if EqualP :WhatProblem "/ [op MakeDivision]
  328.   MakeProblem Pick [+ - * /]
  329. end
  330.  
  331.  
  332. ;
  333. ;  Generate problems.  Magnitudes of the operands are governed
  334. ;  by global variables.  Note that subtraction and division require
  335. ;  special attention.
  336. ;
  337.  
  338. ask :GameWindow [to MakeAddition]
  339.   op (se (random :MaxAugend) "+ (random :MaxAddend))
  340. end
  341.  
  342. ask :GameWindow [to MakeSubtraction]
  343.   LocalMake "Minuend random :MaxMinuend
  344.   DoUntil [LocalMake "Subtrahend random :MaxSubtrahend]
  345. _   [or (LessP :Subtrahend :Minuend) (EqualP :Subtrahend :Minuend)]
  346.   op (se :Minuend "- :Subtrahend)
  347. end
  348.  
  349. ask :GameWindow [to MakeMultiplication]
  350.   op (se (random :MaxMultiplicand) "* (random :MaxMultiplier))
  351. end
  352.  
  353. ask :GameWindow [to MakeDivision]
  354.   LocalMake "Divisor 1 + random :MaxDivisor
  355.   DoUntil [LocalMake "Dividend 1 + random :MaxDividend]
  356. _   [(and
  357. _       (or (GreaterP :Dividend :Divisor) (EqualP :Dividend :Divisor))
  358. _       (EqualP (Remainder :Dividend :Divisor) 0))]
  359.   op (se :Dividend "/ :Divisor)
  360. end
  361.  
  362.  
  363. ;
  364. ;  B U T T O N    O B J E C T    D E F I N I T I O N
  365. ;
  366. ;  The Button is a QuickDraw contsruct similar to a Mac control.
  367. ;  The button is a rounded rectangle and contains a text label.
  368. ;  Clicking on the button causes it to reverse and output its label.
  369. ;
  370.  
  371. make "Button Something
  372.  
  373.  
  374. ask :Button [to exist :Window :Left :Top :Label]
  375.   usual.exist
  376.   have "HoldState
  377.   havemake "ButtonHeight ask :Window [WFontSize]
  378.   havemake "ButtonWidth ask :Window [TextWidth :Label]
  379.   havemake "ButtonWindow :Window
  380.   havemake "ButtonLabel :Label
  381.   havemake "X0 :Left
  382.   havemake "Y0 :Top
  383.   havemake "X1 :X0 + :ButtonWidth + 8
  384.   havemake "Y1 :Y0 + :ButtonHeight + 8
  385.   havemake "ButtonRect (list :X0 :Y0 :X1 :Y1)
  386.   LocalMake "Me self
  387.   ask :ButtonWindow [Make "ButtonList se :me :ButtonList]
  388.   DisplayButton
  389.   op :ButtonWidth + 8
  390. end
  391.  
  392.  
  393. ;
  394. ; DisplayButton procedure.  Uses QuickDraw.
  395. ;
  396.  
  397. ask :Button [to DisplayButton]
  398.   LocalMake "HoldState ask :ButtonWindow [GetPenState]
  399.   LocalMake "TX0 :X0
  400.   LocalMake "TY0 :Y0
  401.   LocalMake "Rect :ButtonRect
  402.   LocalMake "Label :ButtonLabel
  403.   LocalMake "Height :ButtonHeight
  404.   LocalMake "Black [255 255 255 255 255 255 255 255]
  405.   LocalMake "White [0 0 0 0 0 0 0 0]
  406.   ask :ButtonWindow [SetPenMode "Paint]
  407.   ask :ButtonWindow [SetPenSize 2 2]
  408.   ask :ButtonWindow [SetPenPat :Black] 
  409.   ask :ButtonWindow [FrameRoundRect :Rect 8 8]
  410.   ask :ButtonWindow [SetPenPat :White]
  411.   ask :ButtonWindow [PaintRoundRect (InsetRect :Rect 2 2) 8 8]
  412.   ask :ButtonWindow [SetPenPat :Black]
  413.   ask :ButtonWindow [MoveTo :TX0 :TY0]
  414.   ask :ButtonWindow [Move 4 :Height]
  415.   ask :ButtonWindow [type :Label]
  416.   ask :ButtonWindow [SetPenState :HoldState]
  417. end
  418.  
  419.  
  420. ;
  421. ;  Button is clicked.  Reverse it.  Wait for the button to be
  422. ;  released.  Reverse the button again.
  423. ;
  424.  
  425. ask :Button [to ClickButton]
  426.   LocalMake "Rect :ButtonRect
  427.   Ask :ButtonWindow [InvertRoundRect (InsetRect :Rect 2 2) 8 8]
  428.   toot 1000 128 .125
  429.   while [ButtonP] []
  430.   Ask :ButtonWindow [InvertRoundRect (InsetRect :Rect 2 2) 8 8]
  431. end
  432.  
  433.  
  434. ;
  435. ;  Button Instantiation.  
  436. ;  Note: we don't care about the names of the buttons - only their
  437. ;  positions and labels.  Therefore, we can use the primitive .gensym
  438. ;  for naming.
  439. ;
  440.  
  441. to MakeSomeButtons :WhichWindow
  442.   LocalMake "PadX0 86
  443.   LocalMake "XInc 3
  444.   LocalMake "PadY0 180
  445.   LocalMake "PadY1 228
  446.   LocalMake "TopRow [0 1 2 3 4 |Next| |O.K.!|]
  447.   LocalMake "BottomRow [5 6 7 8 9 |Help| |Oops!|]
  448.   MakeSomeButtons2 :PadX0 :PadY0 :XInc :TopRow :WhichWindow
  449.   MakeSomeButtons2 :PadX0 :PadY1 :XInc :BottomRow :WhichWindow
  450. end
  451.  
  452. to MakeSomeButtons2 :X0 :Y0 :XInc :ButtonList :WhichWindow
  453.   LocalMake "X :X0
  454.   LocalMake "I 0
  455.   Repeat Count :ButtonList
  456. _   [LocalMake "Symbol .gensym
  457. _    LocalMake :Symbol kindof :Button
  458. _    LocalMake "I :I + 1
  459. _    LocalMake "Label item :I :ButtonList
  460. _    LocalMake "X :X + :XInc +
  461. _        ask thing :Symbol [exist :WhichWindow :X :Y0 :Label]
  462. _   ]
  463. end
  464.  
  465.  
  466.  
  467. ;
  468. ;  D E F I N E    M E N U    O B J E C T S
  469. ;
  470.  
  471. make "ProblemMenu oneof Menu
  472.  
  473. ask :ProblemMenu [SetTitle "Problem]
  474. ask :ProblemMenu [SetUpItems [
  475. _   |Addition| [ask ActionWindow [HaveMake "WhatKind "+]]
  476. _   |Subtraction| [ask ActionWindow [HaveMake "WhatKind "-]]
  477. _   |Multiplication| [ask ActionWindow [HaveMake "WhatKind "*]]
  478. _   |Division| [ask ActionWindow [HaveMake "WhatKind "/]]
  479. _   |Mixed| [ask ActionWindow [HaveMake "WhatKind "Mixed]]]]
  480.  
  481. ask :ProblemMenu [install]
  482.  
  483.  
  484. ;
  485. ;  Start things going!;
  486. ;
  487.  
  488. make "MathWindow oneof  :GameWindow
  489. MakeSomeButtons :MathWindow
  490.